home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / c01lab1.zip / ADAWKBK / SOL4-3.ADA < prev    next >
Text File  |  1992-11-11  |  3KB  |  104 lines
  1. -- Problem 4.3
  2. -- by Rick Conn
  3. generic
  4.   type ELEMENT is private;
  5.   type INDEX is (<>);
  6.   type VECTOR is array (INDEX range <>) of ELEMENT;
  7.   with function "<" (Left, Right : in ELEMENT) return BOOLEAN;
  8. procedure Bubble_Sort (Item : in out VECTOR);
  9.  
  10. procedure Bubble_Sort (Item : in out VECTOR) is
  11.   Temp : ELEMENT;
  12. begin
  13.   for I in Item'RANGE loop
  14.     for J in INDEX'SUCC(I) .. Item'LAST loop
  15.       if Item(J) < Item(I) then
  16.         Temp    := Item(I);
  17.         Item(I) := Item(J);
  18.         Item(J) := Temp;
  19.       end if;
  20.     end loop;
  21.   end loop;
  22. end Bubble_Sort;
  23.  
  24. with Text_IO;
  25. with Bubble_Sort;
  26. procedure Main is
  27.  
  28.   type REC is record
  29.     N1 : INTEGER;
  30.     N2 : INTEGER;
  31.   end record;
  32.  
  33.   type COLOR is (RED, GREEN, BLUE, YELLOW, VIOLET, GRAY, WHITE);
  34.  
  35.   type RECARRAY is array (COLOR range <>) of REC;
  36.   type INTARRAY is array (NATURAL range <>) of INTEGER;
  37.   type FLTARRAY is array (NATURAL range <>) of FLOAT;
  38.  
  39.   R1 : RECARRAY(RED .. YELLOW) := ((5, 2), (2, 2), (10, 10), (3, 3));
  40.   I1 : INTARRAY(5..9) := (5, 2, 6, 1, 3);
  41.   F1 : FLTARRAY(11..12) := (2.2, 1.1);
  42.  
  43.   function "<" (Left, Right : in REC) return BOOLEAN is
  44.   begin
  45.     return Left.N1 + Left.N2 < Right.N1 + Right.N2;
  46.   end "<";
  47.  
  48.   procedure Int_Sort is new Bubble_Sort
  49.     (ELEMENT => INTEGER,
  50.      INDEX   => NATURAL,
  51.      VECTOR  => INTARRAY,
  52.      "<"     => Standard."<");
  53.  
  54.   procedure Float_Sort is new Bubble_Sort
  55.     (ELEMENT => FLOAT,
  56.      INDEX   => NATURAL,
  57.      VECTOR  => FLTARRAY,
  58.      "<"     => Standard."<");
  59.  
  60.   procedure Rec_Sort is new Bubble_Sort
  61.     (ELEMENT => REC,
  62.      INDEX   => COLOR,
  63.      VECTOR  => RECARRAY,
  64.      "<"     => Main."<");
  65.  
  66.   package Int_IO is new Text_IO.Integer_IO (INTEGER);
  67.   package Flt_IO is new Text_IO.Float_IO (FLOAT);
  68.  
  69.   procedure Print_All is
  70.  
  71.     procedure Rec_Print (R : in REC) is
  72.     begin
  73.       Text_IO.Put("  ("); Int_IO.Put (R.N1, 3); Text_IO.Put(", ");
  74.       Int_IO.Put (R.N2, 3); Text_IO.Put (')');
  75.     end Rec_Print;
  76.  
  77.   begin
  78.     Text_IO.Put ("Records: ");
  79.     for I in R1'RANGE loop
  80.       Rec_Print (R1(I));
  81.     end loop;
  82.     Text_IO.New_Line;
  83.     Text_IO.Put ("Integers: ");
  84.     for I in I1'RANGE loop
  85.       Int_IO.Put (I1(I), 3);
  86.     end loop;
  87.     Text_IO.New_Line;
  88.     Text_IO.Put ("Floats: ");
  89.     for I in F1'RANGE loop
  90.       Flt_IO.Put (F1(I), 3, 1, 0);
  91.     end loop;
  92.     Text_IO.New_Line;
  93.   end Print_All;
  94.  
  95. begin -- Main
  96.  
  97.   Print_All;
  98.   Rec_Sort (R1);
  99.   Int_Sort (I1);
  100.   Float_Sort (F1);
  101.   Print_All;
  102.  
  103. end Main;
  104.